計算機科学実験及演習3 (ソフトウェア)

計算機科学実験及演習3 (ソフトウェア)

テキスト

OCaml入門

「プログラミング言語処理系」講義資料

概要

計算機科学実験及演習3 (ソフトウェア)では「OCaml入門」と「MiniMLインタプリタ作成」と「MiniMLへの型推論の付与」を行う。

範囲

レポート1（OCaml入門）

課題1 回答方法について

レポート2（インタプリタ作成実験）

講義教科書の3章に含まれる全ての必修課題（★印のついてない課題）に加えて，★の数の合計が5個以上になるように選択課題を解く

レポート3（型推論実験）

講義教科書の4章に含まれる全ての必修課題（★印のついてない課題）を解き，実験全体への感想や意見などの自由記述を書く

プロジェクトを作成

code:sh

$ dune init project OcamlTutorial

$ dune exec OcamlTutorial

Hello, World!

$

ex 2.6(2)

円 (整数) を受け取って，US ドル (セント以下を小数にした実数) に換算する関数 (ただし 1 セント以下四捨五入)．レートは 1$ = 111.12 円とする

code:ocaml

(* ex 2.6 (2) *)

(* 目的: ドル(実数)を円(整数)に換算する。換算レートは1ドルは111.12円とする。 *)

(* dolloar_to_yen = float -> int *)

let dollar_to_yen d = int_of_float(d *. 111.12)

let () =

assert((dollar_to_yen 1.0) = 111);

assert((dollar_to_yen 9.0) = 1000);

print_endline "ex 2.6(2): ok"

ex 2.6(4)

文字を受け取って，アルファベットの小文字なら大文字に，その他の文字はそのまま返す関数

capitalize．(例: capitalize ’h’ ⇒ ’H’, capitalize ’1’ ⇒ ’1’)

a → 97

z → 122

A → 65

Z → 90

code:ocaml

(* ex 2.6 (4) *)

(* 目的: アルファベットの小文字を大文字に、大文字を小文字に、それ以外はそのまま返す *)

(* capitalize = char -> char *)

let capitalize c =

let n = int_of_char c in

if n >= 97 && n <= 122 then char_of_int (n - 32)

else if n >= 65 && n <= 90 then char_of_int (n + 32)

else c

let () =

assert((capitalize 'a') = 'A');

assert((capitalize 'A') = 'a');

assert((capitalize 'z') = 'Z');

assert((capitalize 'Z') = 'z');

assert((capitalize '@') = '@');

print_endline "ex 2.6(4): ok"

ex 3.7（再帰呼び出し n 回）

Exercise 3.7 x は実数，n は 0 以上の整数として，xのn乗を計算する pow(x,n) を以下の2種類定義せよ

https://gyazo.com/26ea547783b77261c335fd9a8613d9c1

code:ocaml

(* ex 3.7 (1) *)

(* 目的: 実数xのn乗を返す (ただし n >= 0) *)

(* 再帰呼び出しをn回ともなう *)

(* pow = float -> int -> float *)

let rec pow x n = if n = 0 then 1.0 else x *. pow x (n - 1)

let () =

assert (pow 2.0 0 = 1.0);

assert (pow 2.0 1 = 2.0);

assert (pow 2.0 2 = 4.0);

print_endline "ex 3.7 (1): ok"

ex 3.7（再帰呼び出し log_2 n 回）

2 ** 8

（n回呼び出し）

0 → 1

1 → 2

2 → 4

3 → 8

4 → 16

5 → 32

6 → 64

7 → 128

8 → 256

2^0 = 1

2^1 = 2

2^2 = 4

2^3 = 8

3 = (2 * 1) + 1

2^3 = (2^2) * (2^1)

2^4 = 16

2^4 = 2^{2 * 2}

4 = 2 * 2

2^4 = (2^2)^2 = 4^2 = 16

2^5 = 32

5 =

2^8

8 = 2 * 4

2^8 = (2^2)^4 = 4^4

4^4

4 = 2 * 2

4^4 = (4^2)^2 = 16^2

16^2 = 256

code:ocaml

(* ex 3.7 (2) *)

(* 目的: 実数xのn乗を返す (ただし n >= 0) *)

(* 再帰呼び出しが log_2 n 回ですむ定義 *)

let rec pow1 x n =

if n = 0 then 1.0

else if n = 1 then x

else if n = 2 then x *. x

else

let r = n mod 2 in

let q = n / 2 in

if r = 1 then pow1 x (q * 2) *. x else pow1 (pow1 x 2) q

let () =

assert (pow1 2.0 0 = 1.0);

assert (pow1 2.0 1 = 2.0);

assert (pow1 2.0 2 = 4.0);

assert (pow1 2.0 3 = 8.0);

assert (pow1 2.0 4 = 16.0);

assert (pow1 2.0 5 = 32.0);

assert (pow1 2.0 6 = 64.0);

assert (pow1 2.0 7 = 128.0);

assert (pow1 2.0 8 = 256.0);

print_endline "ex 3.7 (2): ok"

ex 3.11

以下の関数を定義せよ

https://gyazo.com/17c4aa4f1e14758d68374a1780a68d0d

https://gyazo.com/c755d609f67708536d96bbbe5cd4a376

code:ocaml

(* ex 3.11 (1) *)

(* 目的: 自然数 a と b の最大公約数を返す（ただし a > b） *)

(* gcd = int -> int -> int *)

let rec gcd a b =

if a = 0 && b = 0 then 0 (* gcd 0 0 = 0 *)

else if b = 0 then a (* gcd n 0 = n *)

else

let r = a mod b in

if r = 0 then b

else gcd b r

let () =

assert (gcd 0 0 = 0);

assert (gcd 0 5 = 5);

assert (gcd 5 0 = 5);

assert (gcd 5 5 = 5);

assert (gcd 2 3 = 1);

assert (gcd 6 4 = 2);

assert (gcd 1071 1029 = 21);

print_endline "ex 3.11 (1): ok"

ex.5.3(1)-(6)より任意の4つ

code:ocaml

(* ex 5.3 (1) *)

(* 正の整数 n から 0 までの整数の降順リストを生成する関数 downto0 *)

(* downto0 -> int -> int list *)

let rec downto0 n =

else n :: (downto0 (n - 1))

let () =

print_endline "ex 5.3 (1): ok"

レコード型

code:ocaml

type student = {name: string; id: int};;

let thata = {name = "thata"; id = 123};;

ヴァリアント型

code:ocaml

(* 図形を表すヴァリアント型 *)

type figure =

Point

| Circle of int

| Rectangle of int * int

| Square of int

let figures = [

Point;

Circle 2;

Rectangle (2, 3);

Square 4

]

(* 図形の面積を返す *)

(* area = figure -> int

let area f =

match f with

| Point -> 0

| Circle n -> 3 * n * n

| Rectangle (w, h) -> w * h

| Square l -> l * l

let areas = List.map area figures

ex.6.2

Exercise 6.2 nat 型の値をそれが表現する int に変換する関数 int_of_nat, nat 上の掛け算を行

う関数 mul，nat 上の引き算を行う関数 (ただし 0 − n = 0) monus (モーナス) を定義せよ．(mul, monus は *, - などの助けを借りず，nat 型の値から「直接」計算するようにせよ．)

code:ocaml

type nat = Zero | OneMoreThan of nat

let rec add m n =

match m with

| Zero -> n

| OneMoreThan m -> OneMoreThan (add m n)

let rec int_of_nat n =

match n with

| Zero -> 0

| OneMoreThan m -> 1 + int_of_nat m

let () =

assert(int_of_nat Zero = 0);

assert(int_of_nat (add Zero (OneMoreThan Zero)) = 1);

assert(int_of_nat (add (OneMoreThan Zero) (OneMoreThan Zero)) = 2);

print_endline "ex 6.2 / int_of_nat: ok"

let rec mul n1 n2 =

match n2 with

| Zero -> Zero

| OneMoreThan (Zero) -> n1

| OneMoreThan (n) -> add n1 (mul n1 n)

let () =

let zero = Zero in

let one = OneMoreThan zero in

let two = OneMoreThan one in

let three = OneMoreThan two in

let four = OneMoreThan three in

assert(mul zero zero = Zero);

assert(mul one zero = Zero);

assert(mul one one = (OneMoreThan Zero));

assert(mul one two = two);

assert(mul two two = four);

print_endline "ex 6.2 / mul: ok"

let rec monus n1 n2 =

match (n1, n2) with

| (Zero, Zero) -> Zero

| (Zero, _) -> Zero

| (_n1, Zero) -> _n1

| (OneMoreThan (_n1), OneMoreThan (_n2)) -> monus _n1 _n2

let () =

let one = OneMoreThan Zero in

let two = OneMoreThan one in

let three = OneMoreThan two in

let four = OneMoreThan three in

assert(monus Zero Zero = Zero);

assert(monus Zero one = Zero);

assert(monus one Zero = one);

assert(monus one one = Zero);

assert(monus two one = one);

assert(monus three two = one);

assert(monus four two = two);

print_endline "ex 6.2 / monus: ok"

ex.7.1

https://gyazo.com/43b20de291a357ec36721e43c7dbebf7

code:ocaml

type 'a my_ref = { mutable contents: 'a };;

(* ref *)

let my_count = { contents = 999 };;

(* ! *)

my_count.contents;;

=> 999

(* := *)

my_count.contents <- 1000;;

ex.7.2

https://gyazo.com/2f1057c910ee2946b495d29a45647cea

code:ocaml

(* ex 7.2 *)

let incr n = n := !n + 1

let () =

let x = ref 3 in

let _ = incr x in

assert(!x = 4);

print_endline "ex 7.2: ok"

ex.7.4

https://gyazo.com/eaadbc0694b467bea55ec80fa4c374a5

code:ocaml

(* ex 7.4 *)

let fact_imp n =

let i = ref n and res = ref 1 in

while (!i > 0) do

res := !res * !i;

i := !i - 1

done;

!res

let () =

assert((fact_imp 1) = 1);

assert((fact_imp 2) = 2);

assert((fact_imp 3) = 6);

assert((fact_imp 4) = 24);

print_endline "ex 7.4: ok"

インタプリタ作成実験

1章 イントロダクション

Exercise 1.1

OCamlインタプリタに以下の入力を与えたところ，

# let rec f x = if x = 0 then x else false;;

Error: This expression has type bool but an expression was expected of type int.

という応答が返ってきた．この応答の意味するところを，エラーメッセージ中の This が何を指すかを明らかにしつつ，説明せよ．

Exercise 1.2

int型の値nを受け取り，1+...+nを返す関数sumを書け．ただし，nが0以下である場合は例外を投げること．例外の宣言もプログラムに含めよ．

code:ocaml

exception UnderZeroException

let rec sum n =

if n < 0 then raise UnderZeroException

else if n = 0 then 0

else n + (sum (n - 1))

let () =

assert((sum 0) = 0);

assert((sum 1) = 1);

assert((sum 10) = 55);

let result = try (sum (-11)) with UnderZeroException -> 999 in

assert(result = 999);

print_endline "exersize 1.2: ok"

Exercise 1.3

https://gyazo.com/18a0c1a55ab33e4008f224469132b98a

code:ocaml

(* ex 1.3 *)

type bt = Empty | Node of bt * int * bt

(* ツリーの値を合計を返す *)

(* sumtree -> bt -> int *)

let rec sumtree t =

match t with

| Empty -> 0

| Node (t1, v, t2) -> (sumtree t1) + v + (sumtree t2)

let () =

assert(sumtree Empty = 0);

assert(sumtree (Node (Empty, 10, Empty)) = 10);

assert(sumtree (Node ((Node (Empty, 5, (Node (Empty, 3, Empty)))), 10, (Node (Empty, 7, Empty)))) = 25);

print_endline "ok"

let rec mapTree f t =

match t with

| Empty -> Empty

| Node (t1, v, t2) -> Node ((mapTree f t1), f v, (mapTree f t2))

let () =

let double i = i * 2 in

assert((mapTree double Empty) = Empty);

assert(

(mapTree double (Node (Empty, 10, Empty))) = (Node (Empty, 20, Empty))

);

assert(

(mapTree double (Node ((Node (Empty, 5, Empty)), 10, (Node (Empty, 15, Empty))))) = (Node ((Node (Empty, 10, Empty)), 20, (Node (Empty, 30, Empty))))

);

print_endline "ok"

MiniMLを動かしてみる

code:sh

cd src

cd IoPLMaterials/textbook/interpreter

dune build

dune exec miniml

# 1 + 2;;

val - = 3

#

MiniML1: めっちゃサブセット

MiniML2: MiniML1 + 変数定義

MiniML3: MiniML2 + 再帰できない関数の定義・呼び出し

MiniML4: MiniML3 + 再帰関数定義・呼び出し

2章 概論的な話

講義スライド

3章 型無しMiniMLインタプリタの実装

講義スライド

Githubリポジトリ

MiniML1のシンタックス

P ::= e ;;

b ::= true | false

e ::= <識別子> | <自然数リテラル> | b | e op e | if e then e else e | ( e )

op ::= + | * | <

予約後

優先順位と結合

優先順位と結合を以下の通り定める．演算子 +と*は左結合とする．また，結合の強さは，強い方から*, +, <, if式とする

Syntax モジュール

抽象構文のためのデータ型の定義

code:ocaml

open Miniml.Syntax;;

(* if true then 1 else 2 *)

Exp (IfExp (BLit (true), ILit (1), ILit (2)));;

- : program = Exp (IfExp (BLit true, ILit 1, ILit 2))

(* 4 + 5 *)

BinOp (Plus, ILit (4), ILit (5));;

- : exp = BinOp (Plus, ILit 4, ILit 5)

Environment モジュール

code:ocaml

let env = Miniml.Environment.extend "x" (Miniml.Eval.IntV 10) Miniml.Environment.empty in

Miniml.Environment.lookup "x" env;;

Eval モジュール

code:ocaml

(* eval_exp *)

let

exp = Miniml.Syntax.BinOp (Miniml.Syntax.Plus, Miniml.Syntax.ILit (3), Miniml.Syntax.ILit (5)) and

env = Miniml.Environment.empty in

Miniml.Eval.eval_exp env exp;;

code:ocaml

(* eval_decl *)

let

exp = Miniml.Syntax.Exp (Miniml.Syntax.BinOp (Miniml.Syntax.Plus, Miniml.Syntax.ILit (3), Miniml.Syntax.ILit (5))) and

env = Miniml.Environment.empty in

Miniml.Eval.eval_decl env exp;;

("-", <abstr>, Miniml.Eval.IntV 8)

code:ocaml

(* apply_prim *)

Miniml.Eval.apply_prim Miniml.Syntax.Plus (Miniml.Eval.IntV (10)) (Miniml.Eval.IntV (20));;

Exercise 3.2.1 【必修】

MiniML1 インタプリタのプログラムをコンパイル・実行し，インタプリタの動作を確かめよ．

code:ocaml

$ dune exec miniml

# 1 + 2;;

parsing done

val - = 3

# x + 2;;

parsing done

val - = 12

# i + v + x;;

parsing done

val - = 16

#

大域環境として i, v, x の値のみが定義されているが，ii が 2，iii が 3，iv が 4 となるようにプログラムを変更して，動作を確かめよ．例えば，iv + iii * iiなどが正しく評価されるかを試してみよ．

code:diff

diff --git a/textbook/interpreter/src/cui.ml b/textbook/interpreter/src/cui.ml

index ae9cf80..afb841a 100644

--- a/textbook/interpreter/src/cui.ml

+++ b/textbook/interpreter/src/cui.ml

@@ -12,6 +12,9 @@ let rec read_eval_print env =

read_eval_print newenv

let initial_env =

- Environment.extend "i" (IntV 1)

- (Environment.extend "v" (IntV 5)

- (Environment.extend "x" (IntV 10) Environment.empty))

+ Environment.extend "iv" (IntV 4)

+ (Environment.extend "iii" (IntV 3)

+ (Environment.extend "ii" (IntV 2)

+ (Environment.extend "i" (IntV 1)

+ (Environment.extend "v" (IntV 5)

+ (Environment.extend "x" (IntV 10) Environment.empty)))))

code:ocaml

$ dune exec miniml

# iv + iii * ii;;

parsing done

val - = 10

#

Exercise 3.2.2 【**】

このインタプリタは文法にあわない入力を与えたり，束縛されていない変数を参照しようとすると，プログラムの実行が終了してしまう．このような入力を与えた場合，適宜メッセージを出力して，インタプリタプロンプトに戻るように改造せよ．

code:diff

diff --git a/textbook/interpreter/src/cui.ml b/textbook/interpreter/src/cui.ml

index afb841a..883da10 100644

--- a/textbook/interpreter/src/cui.ml

+++ b/textbook/interpreter/src/cui.ml

@@ -3,13 +3,18 @@ open Eval

let rec read_eval_print env =

print_string "# ";

flush stdout;

- let decl = Parser.toplevel Lexer.main (Lexing.from_channel stdin) in

- let _ = print_string "parsing done\n"; flush stdout in

- let (id, newenv, v) = eval_decl env decl in

- Printf.printf "val %s = " id;

- pp_val v;

- print_newline();

- read_eval_print newenv

+ try

+ let decl = Parser.toplevel Lexer.main (Lexing.from_channel stdin) in

+ let _ = print_string "parsing done\n"; flush stdout in

+ let (id, newenv, v) = eval_decl env decl in

+ Printf.printf "val %s = " id;

+ pp_val v;

+ print_newline();

+ read_eval_print newenv

+ with _ ->

+ print_string "Error";

+ print_newline ();

+ read_eval_print env

let initial_env =

Environment.extend "iv" (IntV 4)

実行結果

code:sh

$ dune exec miniml

# 1 + 2;;

parsing done

val - = 3

# 1 ** 2;;

Error

# hello + world;;

parsing done

Error

#

Exercise 3.2.3 【*】

論理値演算のための二項演算子 &&, || を追加せよ．

code:diff

diff --git a/textbook/interpreter/src/eval.ml b/textbook/interpreter/src/eval.ml

index df002bb..d29a537 100644

--- a/textbook/interpreter/src/eval.ml

+++ b/textbook/interpreter/src/eval.ml

@@ -23,6 +23,10 @@ let rec apply_prim op arg1 arg2 = match op, arg1, arg2 with

| Mult, _, _ -> err ("Both arguments must be integer: *")

| Lt, IntV i1, IntV i2 -> BoolV (i1 < i2)

| Lt, _, _ -> err ("Both arguments must be integer: <")

+ | And, BoolV b1, BoolV b2 -> BoolV (b1 && b2)

+ | And, _, _ -> err ("Both arguments must be boolean: *")

+ | Or, BoolV b1, BoolV b2 -> BoolV (b1 || b2)

+ | Or, _, _ -> err ("Both arguments must be boolean: *")

let rec eval_exp env = function

Var x ->

diff --git a/textbook/interpreter/src/lexer.mll b/textbook/interpreter/src/lexer.mll

index 55e974c..8e090f9 100644

--- a/textbook/interpreter/src/lexer.mll

+++ b/textbook/interpreter/src/lexer.mll

@@ -22,6 +22,8 @@ rule main = parse

| "+" { Parser.PLUS }

| "*" { Parser.MULT }

| "<" { Parser.LT }

+| "&&" { Parser.AND }

+| "||" { Parser.OR }

{ let id = Lexing.lexeme lexbuf in

@@ -31,5 +33,3 @@ rule main = parse

_ -> Parser.ID id

}

| eof { exit 0 }

-

-

diff --git a/textbook/interpreter/src/parser.mly b/textbook/interpreter/src/parser.mly

index 9885232..bec6476 100644

--- a/textbook/interpreter/src/parser.mly

+++ b/textbook/interpreter/src/parser.mly

@@ -3,7 +3,7 @@ open Syntax

%}

%token LPAREN RPAREN SEMISEMI

-%token PLUS MULT LT

+%token PLUS MULT LT AND OR

%token IF THEN ELSE TRUE FALSE

%token EOF

@@ -20,6 +20,11 @@ toplevel :

Expr :

e=IfExpr { e }

| e=LTExpr { e }

+ | e=BOExpr { e }

+

+BOExpr :

+ l=AExpr AND r=AExpr { BinOp (And, l, r) }

+ | l=AExpr OR r=AExpr { BinOp (Or, l, r) }

LTExpr :

l=PExpr LT r=PExpr { BinOp (Lt, l, r) }

diff --git a/textbook/interpreter/src/syntax.ml b/textbook/interpreter/src/syntax.ml

index 9899e53..f219c3f 100644

--- a/textbook/interpreter/src/syntax.ml

+++ b/textbook/interpreter/src/syntax.ml

@@ -1,7 +1,7 @@

(* ML interpreter / type reconstruction *)

type id = string

-type binOp = Plus | Mult | Lt

+type binOp = Plus | Mult | Lt | And | Or

type exp =

Var of id

Exercise 3.2.4 【**】

lexer.mllを改造し，(*と*)で囲まれたコメントを読み飛ばすようにせよ．なお，OCamlのコメントは入れ子にできることに注意せよ．ocamllex のドキュメントを読む必要があるかもしれない．（ヒント1: (*と*)が正しく入れ子になっている語の集合は正則言語ではないので，正則表現を工夫するだけで頑張るのは無理．）（ヒント2：commentという再帰的なルールをlexer.mllに新しく定義するとよい．）

（これは飛ばす）

MiniML2

変数宣言の機能を let 宣言と let 式として導入する。

Exercise 3.3.1 【必修】

MiniML1 インタプリタを拡張して，MiniML2 インタプリタを作成し，テストせよ．

code:diff

diff --git a/textbook/interpreter/src/eval.ml b/textbook/interpreter/src/eval.ml

index d29a537..d722151 100644

--- a/textbook/interpreter/src/eval.ml

+++ b/textbook/interpreter/src/eval.ml

@@ -44,6 +44,11 @@ let rec eval_exp env = function

BoolV true -> eval_exp env exp2

| BoolV false -> eval_exp env exp3

| _ -> err ("Test expression must be boolean: if"))

+ | LetExp (id, exp1, exp2) ->

+ let value = eval_exp env exp1 in

+ eval_exp (Environment.extend id value env) exp2

let eval_decl env = function

Exp e -> let v = eval_exp env e in ("-", env, v)

+ | Decl (id, e) ->

+ let v = eval_exp env e in (id, Environment.extend id v env, v)

diff --git a/textbook/interpreter/src/lexer.mll b/textbook/interpreter/src/lexer.mll

index 8e090f9..ba8a8b7 100644

--- a/textbook/interpreter/src/lexer.mll

+++ b/textbook/interpreter/src/lexer.mll

@@ -6,6 +6,8 @@ let reservedWords = [

("if", Parser.IF);

("then", Parser.THEN);

("true", Parser.TRUE);

+ ("in", Parser.IN);

+ ("let", Parser.LET);

]

}

@@ -24,6 +26,7 @@ rule main = parse

| "<" { Parser.LT }

| "&&" { Parser.AND }

| "||" { Parser.OR }

+| "=" { Parser.EQ }

{ let id = Lexing.lexeme lexbuf in

diff --git a/textbook/interpreter/src/parser.mly b/textbook/interpreter/src/parser.mly

index bec6476..bbe0b30 100644

--- a/textbook/interpreter/src/parser.mly

+++ b/textbook/interpreter/src/parser.mly

@@ -5,6 +5,7 @@ open Syntax

%token LPAREN RPAREN SEMISEMI

%token PLUS MULT LT AND OR

%token IF THEN ELSE TRUE FALSE

+%token LET IN EQ

%token EOF

%token <int> INTV

@@ -16,12 +17,17 @@ open Syntax

toplevel :

e=Expr SEMISEMI { Exp e }

+ | LET x=ID EQ e=Expr SEMISEMI { Decl (x, e) }

Expr :

e=IfExpr { e }

+ | e=LetExpr { e }

| e=LTExpr { e }

| e=BOExpr { e }

+LetExpr :

+ LET x=ID EQ e1=Expr IN e2=Expr { LetExp (x, e1, e2) }

+

BOExpr :

l=AExpr AND r=AExpr { BinOp (And, l, r) }

| l=AExpr OR r=AExpr { BinOp (Or, l, r) }

diff --git a/textbook/interpreter/src/syntax.ml b/textbook/interpreter/src/syntax.ml

index f219c3f..fb8283d 100644

--- a/textbook/interpreter/src/syntax.ml

+++ b/textbook/interpreter/src/syntax.ml

@@ -9,9 +9,11 @@ type exp =

| BLit of bool

| BinOp of binOp * exp * exp

| IfExp of exp * exp * exp

+ | LetExp of id * exp * exp

type program =

Exp of exp

+ | Decl of id * exp

type tyvar = int

type ty =

テスト

code:sh

$ dune exec miniml

# a;;

parsing done

Error

# let a = 9 * 9;;

parsing done

val a = 81

# a;;

parsing done

val - = 81

# let a = 10 in let b = 20 in 10 + 20;;

parsing done

val - = 30

# a;;

parsing done

val - = 81

Exercise 3.3.3 【**】

バッチインタプリタを作成せよ．具体的には miniml コマンドの引数とし て ファイル名をとり，そのファイルに書かれたプログラムを評価し，結果をディ スプレイに出力するように変更せよ．また，コメントを無視するよう実装せ よ．(オプション: ;; で区切られたプログラムの列が読み込めるようにせよ．)

ファイル名が渡されたらバッチ実行するようにした。

code:diff

diff --git a/textbook/interpreter/main.ml b/textbook/interpreter/main.ml

index 3089425..064cb75 100644

--- a/textbook/interpreter/main.ml

+++ b/textbook/interpreter/main.ml

@@ -1,3 +1,9 @@

open Miniml.Cui

-let _ = read_eval_print initial_env

+let _ =

+ if (Array.length Sys.argv > 1) then

+ (* Batch Exec *)

+ batch_eval Sys.argv.(1) initial_env

+ else

+ (* REPL *)

+ read_eval_print initial_env

diff --git a/textbook/interpreter/src/cui.ml b/textbook/interpreter/src/cui.ml

index 7a1a787..a20cb93 100644

--- a/textbook/interpreter/src/cui.ml

+++ b/textbook/interpreter/src/cui.ml

@@ -16,6 +16,19 @@ let rec read_eval_print env =

print_newline ();

read_eval_print env

+let batch_eval file env =

+ try

+ let in_ch = open_in file in

+ let decl = Parser.toplevel Lexer.main (Lexing.from_channel in_ch) in

+ let _ = print_string "parsing done\n"; flush stdout in

+ let (id, _, v) = eval_decl env decl in

+ Printf.printf "val %s = " id;

+ pp_val v;

+ print_newline();

+ with _ ->

+ print_string "Error";

+ print_newline ()

+

let initial_env =

Environment.extend "iv" (IntV 4)

(Environment.extend "iii" (IntV 3)

バッチ実行のサンプルプログラムはこんな感じ。

code:foo.ml

(* return 55 *)

1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10;;

実行結果は以下のとおり。

code:sh

$ dune exec miniml foo.ml

parsing done

val - = 55

$

コメントアウトの方法

以下を参考にコメントを入れられるようにした。

code:diff

diff --git a/textbook/interpreter/src/lexer.mll b/textbook/interpreter/src/lexer.mll

index ba8a8b7..08a3f95 100644

--- a/textbook/interpreter/src/lexer.mll

+++ b/textbook/interpreter/src/lexer.mll

@@ -27,6 +27,7 @@ rule main = parse

| "&&" { Parser.AND }

| "||" { Parser.OR }

| "=" { Parser.EQ }

+| "(*" { comment lexbuf; main lexbuf }

{ let id = Lexing.lexeme lexbuf in

@@ -36,3 +37,9 @@ rule main = parse

_ -> Parser.ID id

}

| eof { exit 0 }

+

+and comment = parse

+ "*)" { () }

+| "(*" { comment lexbuf; comment lexbuf }

+| eof { () }

+| _ { comment lexbuf }

MiniML3: 関数の導入

Exercise 3.4.1【必修】

MiniML3 インタプリタを作成し，高階関数が正しく動作するかなどを含めて テストせよ．

code:diff

diff --git a/textbook/interpreter/src/cui.ml b/textbook/interpreter/src/cui.ml

index a20cb93..b11ef1c 100644

--- a/textbook/interpreter/src/cui.ml

+++ b/textbook/interpreter/src/cui.ml

@@ -11,9 +11,10 @@ let rec read_eval_print env =

pp_val v;

print_newline();

read_eval_print newenv

- with _ ->

- print_string "Error";

- print_newline ();

+ with e ->

+ let msg = Printexc.to_string e in

+ print_string ("Error: " ^ msg);

+ print_newline ();

read_eval_print env

let batch_eval file env =

diff --git a/textbook/interpreter/src/eval.ml b/textbook/interpreter/src/eval.ml

index d722151..b20bd68 100644

--- a/textbook/interpreter/src/eval.ml

+++ b/textbook/interpreter/src/eval.ml

@@ -3,6 +3,7 @@ open Syntax

type exval =

IntV of int

| BoolV of bool

+ | ProcV of id * exp * dnval Environment.t

and dnval = exval

exception Error of string

@@ -13,6 +14,7 @@ let err s = raise (Error s)

let rec string_of_exval = function

IntV i -> string_of_int i

| BoolV b -> string_of_bool b

+ | ProcV _ -> "<fun>"

let pp_val v = print_string (string_of_exval v)

@@ -47,6 +49,16 @@ let rec eval_exp env = function

| LetExp (id, exp1, exp2) ->

let value = eval_exp env exp1 in

eval_exp (Environment.extend id value env) exp2

+ | FunExp (id, exp) -> ProcV (id, exp, env)

+ | AppExp (exp1, exp2) ->

+ let funval = eval_exp env exp1 in

+ let arg = eval_exp env exp2 in

+ (match funval with

+ | ProcV (id, body, env') ->

+ let newenv = Environment.extend id arg env' in

+ eval_exp newenv body

+ | _ ->

+ err ("Non-function value is applied"))

let eval_decl env = function

Exp e -> let v = eval_exp env e in ("-", env, v)

diff --git a/textbook/interpreter/src/lexer.mll b/textbook/interpreter/src/lexer.mll

index 08a3f95..c1555aa 100644

--- a/textbook/interpreter/src/lexer.mll

+++ b/textbook/interpreter/src/lexer.mll

@@ -8,6 +8,7 @@ let reservedWords = [

("true", Parser.TRUE);

("in", Parser.IN);

("let", Parser.LET);

+ ("fun", Parser.FUN);

]

}

@@ -27,6 +28,7 @@ rule main = parse

| "&&" { Parser.AND }

| "||" { Parser.OR }

| "=" { Parser.EQ }

+| "->" { Parser.RARROW }

| "(*" { comment lexbuf; main lexbuf }

diff --git a/textbook/interpreter/src/parser.mly b/textbook/interpreter/src/parser.mly

index bbe0b30..63a6b2a 100644

--- a/textbook/interpreter/src/parser.mly

+++ b/textbook/interpreter/src/parser.mly

@@ -6,6 +6,7 @@ open Syntax

%token PLUS MULT LT AND OR

%token IF THEN ELSE TRUE FALSE

%token LET IN EQ

+%token RARROW FUN

%token EOF

%token <int> INTV

@@ -24,6 +25,10 @@ Expr :

| e=LetExpr { e }

| e=LTExpr { e }

| e=BOExpr { e }

+ | e=FunExpr { e }

+

+FunExpr :

+ FUN x=ID RARROW e=Expr { FunExp (x, e) }

LetExpr :

LET x=ID EQ e1=Expr IN e2=Expr { LetExp (x, e1, e2) }

@@ -42,6 +47,10 @@ PExpr :

MExpr :

l=MExpr MULT r=AExpr { BinOp (Mult, l, r) }

+ | e=AppExpr { e }

+

+AppExpr :

+ e1=AppExpr e2=AppExpr { AppExp (e1, e2) }

| e=AExpr { e }

AExpr :

diff --git a/textbook/interpreter/src/syntax.ml b/textbook/interpreter/src/syntax.ml

index fb8283d..efe6383 100644

--- a/textbook/interpreter/src/syntax.ml

+++ b/textbook/interpreter/src/syntax.ml

@@ -10,6 +10,8 @@ type exp =

| BinOp of binOp * exp * exp

| IfExp of exp * exp * exp

| LetExp of id * exp * exp

+ | FunExp of id * exp

+ | AppExp of exp * exp

type program =

Exp of exp

動作確認

code:sh

$ dune exec miniml

# let double = fun x -> x + x in double 100;;

parsing done

val - = 200

#

MiniML4: 再帰的関数定義の導入

Exercise 3.5.1 【必修】

図に示した syntax.ml にしたがって，parser.mly と lexer.mll を完成させ，MiniML4 インタプリタを作成し，テストせよ．(let rec式だけでなくlet rec宣言も実装すること．)

クロージャ内の環境を差し替えれるようにするため、クロージャ内の環境を参照型で保持するようにする。

code:diff

diff --git a/textbook/interpreter/src/eval.ml b/textbook/interpreter/src/eval.ml

index b20bd68..c60fc80 100644

--- a/textbook/interpreter/src/eval.ml

+++ b/textbook/interpreter/src/eval.ml

@@ -3,7 +3,7 @@ open Syntax

type exval =

IntV of int

| BoolV of bool

- | ProcV of id * exp * dnval Environment.t

+ | ProcV of id * exp * dnval Environment.t ref

and dnval = exval

exception Error of string

@@ -49,13 +49,13 @@ let rec eval_exp env = function

| LetExp (id, exp1, exp2) ->

let value = eval_exp env exp1 in

eval_exp (Environment.extend id value env) exp2

- | FunExp (id, exp) -> ProcV (id, exp, env)

+ | FunExp (id, exp) -> ProcV (id, exp, ref env)

| AppExp (exp1, exp2) ->

let funval = eval_exp env exp1 in

let arg = eval_exp env exp2 in

(match funval with

| ProcV (id, body, env') ->

- let newenv = Environment.extend id arg env' in

+ let newenv = Environment.extend id arg !env' in

eval_exp newenv body

| _ ->

err ("Non-function value is applied"))

再帰関数を呼べるようにした。

code:diff

diff --git a/textbook/interpreter/src/eval.ml b/textbook/interpreter/src/eval.ml

index b20bd68..17f199d 100644

--- a/textbook/interpreter/src/eval.ml

+++ b/textbook/interpreter/src/eval.ml

@@ -3,7 +3,7 @@ open Syntax

type exval =

IntV of int

| BoolV of bool

- | ProcV of id * exp * dnval Environment.t

+ | ProcV of id * exp * dnval Environment.t ref

and dnval = exval

exception Error of string

@@ -29,6 +29,9 @@ let rec apply_prim op arg1 arg2 = match op, arg1, arg2 with

| And, _, _ -> err ("Both arguments must be boolean: *")

| Or, BoolV b1, BoolV b2 -> BoolV (b1 || b2)

| Or, _, _ -> err ("Both arguments must be boolean: *")

+ | Eql, IntV i1, IntV i2 -> BoolV (i1 = i2)

+ | Eql, BoolV b1, BoolV b2 -> BoolV (b1 = b2)

+ | Eql, _, _ -> err ("Both arguments type must be matched: *")

let rec eval_exp env = function

Var x ->

@@ -49,18 +52,29 @@ let rec eval_exp env = function

| LetExp (id, exp1, exp2) ->

let value = eval_exp env exp1 in

eval_exp (Environment.extend id value env) exp2

- | FunExp (id, exp) -> ProcV (id, exp, env)

+ | FunExp (id, exp) -> ProcV (id, exp, ref env)

| AppExp (exp1, exp2) ->

let funval = eval_exp env exp1 in

let arg = eval_exp env exp2 in

(match funval with

| ProcV (id, body, env') ->

- let newenv = Environment.extend id arg env' in

+ let newenv = Environment.extend id arg !env' in

eval_exp newenv body

| _ ->

err ("Non-function value is applied"))

+ | LetRecExp (id, para, exp1, exp2) ->

+ let dummyenv = ref Environment.empty in

+ let newenv = Environment.extend id (ProcV (para, exp1, dummyenv)) env in

+ dummyenv := newenv;

+ eval_exp newenv exp2

let eval_decl env = function

Exp e -> let v = eval_exp env e in ("-", env, v)

- | Decl (id, e) ->

- let v = eval_exp env e in (id, Environment.extend id v env, v)

+ | Decl (id, exp) ->

+ let v = eval_exp env exp in (id, Environment.extend id v env, v)

+ | RecDecl (id, para, exp) ->

+ let dummyenv = ref Environment.empty in

+ let f = ProcV (para, exp, dummyenv) in

+ let newenv = Environment.extend id f env in

+ dummyenv := newenv;

+ (id, newenv, f)

diff --git a/textbook/interpreter/src/lexer.mll b/textbook/interpreter/src/lexer.mll

index c1555aa..8b63de0 100644

--- a/textbook/interpreter/src/lexer.mll

+++ b/textbook/interpreter/src/lexer.mll

@@ -9,6 +9,8 @@ let reservedWords = [

("in", Parser.IN);

("let", Parser.LET);

("fun", Parser.FUN);

+ ("eq", Parser.EQL);

+ ("rec", Parser.REC);

]

}

diff --git a/textbook/interpreter/src/parser.mly b/textbook/interpreter/src/parser.mly

index 63a6b2a..7810c2b 100644

--- a/textbook/interpreter/src/parser.mly

+++ b/textbook/interpreter/src/parser.mly

@@ -7,6 +7,8 @@ open Syntax

%token IF THEN ELSE TRUE FALSE

%token LET IN EQ

%token RARROW FUN

+%token EQL

+%token REC

%token EOF

%token <int> INTV

@@ -19,6 +21,7 @@ open Syntax

toplevel :

e=Expr SEMISEMI { Exp e }

| LET x=ID EQ e=Expr SEMISEMI { Decl (x, e) }

+ | LET REC x=ID EQ FUN p=ID RARROW e=Expr SEMISEMI { RecDecl (x, p, e) }

Expr :

e=IfExpr { e }

@@ -26,6 +29,7 @@ Expr :

| e=LTExpr { e }

| e=BOExpr { e }

| e=FunExpr { e }

+ | e=LetRecExpr { e }

FunExpr :

FUN x=ID RARROW e=Expr { FunExp (x, e) }

@@ -33,9 +37,13 @@ FunExpr :

LetExpr :

LET x=ID EQ e1=Expr IN e2=Expr { LetExp (x, e1, e2) }

+LetRecExpr :

+ LET REC x=ID EQ FUN p=ID RARROW e1=Expr IN e2=Expr { LetRecExp (x, p, e1, e2) }

+

BOExpr :

l=AExpr AND r=AExpr { BinOp (And, l, r) }

| l=AExpr OR r=AExpr { BinOp (Or, l, r) }

+ | l=AExpr EQL r=AExpr { BinOp (Eql, l, r) }

LTExpr :

l=PExpr LT r=PExpr { BinOp (Lt, l, r) }

diff --git a/textbook/interpreter/src/syntax.ml b/textbook/interpreter/src/syntax.ml

index efe6383..8d6f1a3 100644

--- a/textbook/interpreter/src/syntax.ml

+++ b/textbook/interpreter/src/syntax.ml

@@ -1,7 +1,7 @@

(* ML interpreter / type reconstruction *)

type id = string

-type binOp = Plus | Mult | Lt | And | Or

+type binOp = Plus | Mult | Lt | And | Or | Eql

type exp =

Var of id

@@ -12,10 +12,12 @@ type exp =

| LetExp of id * exp * exp

| FunExp of id * exp

| AppExp of exp * exp

+ | LetRecExp of id * id * exp * exp

type program =

Exp of exp

| Decl of id * exp

+ | RecDecl of id * id * exp

type tyvar = int

type ty =

let rec 式を呼び出してみる。

code:sh

$ dune exec miniml

# let rec fact = fun n -> if n eq 0 then 1 else n * (fact (n + (-1))) in fact 5;;

parsing done

val - = 120

#

let rec 宣言を呼び出してみる。

code:sh

$ dune exec miniml

# let rec fact = fun n -> if n eq 0 then 1 else n * (fact (n + (-1)));;

parsing done

val fact = <fun>

# fact 5;;

parsing done

val - = 120

#

MiniML5（やりこみ課題）

（これはやらなくても良いかな）

型推論もあんまり興味ないのでインタプリタはここで終わり。